home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / WORMHOL1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  1.4 KB  |  78 lines
  1.  
  2. program wormhole; { WORMHOL1.PAS}
  3. { 1st version of wormhole, add movement by changing colors, by Bas van Gaalen }
  4. uses u_vga,u_pal,u_3d,u_kb;
  5. const
  6.   divd=128;
  7.   astep=5;
  8.   xst=4;
  9.   yst=5;
  10. var
  11.   virscr:pointer;
  12.   lstep:byte;
  13.  
  14. procedure drawpolar(xo,yo,r,a:word; c:byte); assembler;
  15. asm
  16.   les di,virscr
  17.   mov bx,a
  18.   add bx,a
  19.   mov cx,word ptr stab[bx]
  20.   mov ax,word ptr ctab[bx]
  21.   mul r
  22.   mov bx,divd
  23.   xor dx,dx
  24.   cwd
  25.   idiv bx
  26.   add ax,xo
  27.   add ax,160
  28.   cmp ax,319
  29.   ja @out
  30.   mov si,ax
  31.   mov ax,cx
  32.   mul r
  33.   mov bx,divd
  34.   xor dx,dx
  35.   cwd
  36.   idiv bx
  37.   add ax,yo
  38.   add ax,100
  39.   cmp ax,199
  40.   ja @out
  41.   shl ax,6
  42.   mov di,ax
  43.   shl ax,2
  44.   add di,ax
  45.   add di,si
  46.   mov al,c
  47.   mov [es:di],al
  48.  @out:
  49. end;
  50.  
  51. var x,y,i,j:word; c:byte;
  52. begin
  53.   setvideo($13);
  54.   for i:=1 to 255 do setrgb(i,15+i shr 1,15+i shr 1,20+i shr 1);
  55.   getmem(virscr,64000); cls(virscr,64000);
  56.   x:=30; y:=90;
  57.   repeat
  58.     {retrace;}
  59.     c:=5; lstep:=2; j:=10;
  60.     while j<220 do begin
  61.       i:=0;
  62.       while i<255 do begin
  63.         drawpolar(ctab[(x+(200-j)) mod 255] div 3,stab[(y+(200-j)) mod 255] div 3,j,i,c);
  64.         inc(i,astep);
  65.       end;
  66.       inc(j,lstep);
  67.       if (j mod 5)=0 then begin inc(lstep); inc(c,10); end;
  68.     end;
  69.     x:=xst+x mod 255;
  70.     y:=yst+y mod 255;
  71.     flip(virscr,vidptr,64000);
  72.     cls(virscr,64000);
  73.   until keypressed;
  74.   clearkeybuf;
  75.   freemem(virscr,64000);
  76.   setvideo(u_lm);
  77. end.
  78.